home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0187.ZIP / CHUCKLCK.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-20  |  4KB  |  155 lines
  1. (*
  2.  * chuckaluck
  3.  * you choose a number between 1 and 6.
  4.  * I roll three dice, if you match 1, you
  5.  * get even money. If you match 2 dice,
  6.  * you get double, if you match all three,
  7.  * you get triple.
  8.  *)
  9.  
  10. program chuckaluck(input,output);
  11.  
  12. const
  13.  
  14.    startmoney   =  1000;     (* amount of money you start with *)
  15.  
  16.    maxdie       =     6;     (* maximum value of a die *)
  17.    mindie       =     1;     (* minimum value of a die *)
  18.  
  19.    numdie       =     3;     (* number of dice *)
  20.  
  21.    payoff1      =     1;     (* pay off even money on 1 match *)
  22.    payoff2      =     2;     (* pay off double on two *)
  23.    payoff3      =     3;     (* pay off triple on three *)
  24. type
  25.    str80  = string[80];
  26.  
  27. var
  28.    money  : integer;         (* the amount of money you have *)
  29.    bet    : integer;         (* amount you bet *)
  30.    guess  : mindie..maxdie;  (* the die you guess *)
  31.    ch     : char;            (* used for input *)
  32.    eachdie: 1..numdie;       (* index used to roll die *)
  33.    matched: 0..numdie;       (* number of matched dice *)
  34.  
  35. (*
  36.  * inst
  37.  * prints out instructions
  38.  *)
  39.  
  40. procedure inst;
  41. begin
  42.  
  43.    writeln('Chuck-a-luck');
  44.    writeln;
  45.    writeln('You choose a number between 1 and 6.');
  46.    writeln('I roll three dice, if you match 1, you');
  47.    writeln('get even money. If you match 2 dice,');
  48.    writeln('you get double your bet, if you match all');
  49.    writeln('three, you get triple.');
  50.    writeln
  51. end;  (* inst *)
  52.  
  53. (*
  54.  * getnum
  55.  * ask a question from the player,
  56.  * and get a number between min and
  57.  * max with error checking
  58.  *)
  59.  
  60. function getnum(question:str80;min,max:integer):integer;
  61.  
  62. var
  63.    inter : integer;          (* intermediate result *)
  64. begin
  65.    write(question);
  66.    readln(inter);
  67.    if (inter < min) or (inter > max) then
  68.    begin
  69.       writeln('only numbers between ',min,' and ',max,' are allowed.');
  70.       getnum := getnum(question,min,max)
  71.    end
  72.    else
  73.       getnum := inter
  74. end;  (* getnum *)
  75.  
  76. (*
  77.  * rolldie
  78.  * roll a die and print out its
  79.  * value.
  80.  *)
  81.  
  82. function rolldie: integer;
  83.  
  84. var
  85.    dievalue : mindie..maxdie;
  86. begin
  87.    randomize;
  88.    dievalue := mindie + random(maxdie);
  89.    write(dievalue:4,'  ');
  90.    rolldie := dievalue
  91. end; (* rolldie *)
  92.  
  93.  
  94. begin
  95.    money := startmoney;
  96.  
  97.    write('Want instructions? ');
  98.    readln(ch);
  99.    if (ch = 'y') or (ch = 'Y') then
  100.       inst;
  101.  
  102.  
  103.    repeat
  104.       writeln;
  105.       writeln('You have $',money);
  106.       bet := getnum('How large a bet? ',1,money);
  107.       guess := getnum('Pick a number ',mindie,maxdie);
  108.  
  109.       matched := 0;
  110.       writeln('Die1  Die2  Die3');
  111.       for eachdie := 1 to numdie do
  112.          if rolldie = guess then
  113.             matched := matched + 1;
  114.  
  115.       writeln;
  116.  
  117.       if matched = 1 then
  118.       begin
  119.          writeln('You won $',bet*payoff1);
  120.          money := money + bet*payoff1
  121.       end
  122.  
  123.       else
  124.       if matched = 2 then
  125.       begin
  126.          writeln('you won $',bet*payoff2);
  127.          money := money + bet*payoff2
  128.       end
  129.  
  130.       else
  131.       if matched = 3 then
  132.       begin
  133.          writeln('You won $',bet*payoff3);
  134.          money := money + bet*payoff3
  135.       end
  136.  
  137.       else
  138.       begin
  139.          writeln('You lost $',bet);
  140.          money := money - bet
  141.       end;
  142.  
  143.       if money > 0 then
  144.       begin
  145.          write('Care to try your luck again? ');
  146.          readln(ch)
  147.       end
  148.  
  149.    until (money <= 0) or ((ch<>'y') and (ch<>'Y'));
  150.  
  151.    writeln('You leave with $',money)
  152.  
  153. end.  (* chuckaluck *)
  154.  
  155.